home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyHeapWatcher.p < prev    next >
Encoding:
Text File  |  1996-10-11  |  1.5 KB  |  87 lines  |  [TEXT/CWIE]
  1. unit MyHeapWatcher;
  2.  
  3. interface
  4.  
  5.     procedure StartupHeapWatcher;
  6.     procedure ConfigureHeapWatcher( enabled: boolean );
  7.     
  8. implementation
  9.  
  10.     uses
  11.         MyOOMainLoop, MyStartup, MyAssertions, MyUtils, MyDialogs;
  12.     
  13. {$ifc not do_debug}
  14.  
  15.     procedure StartupHeapWatcher;
  16.     begin
  17.     end;
  18.     
  19.     procedure ConfigureHeapWatcher( enabled: boolean );
  20.     begin
  21.     end;
  22.     
  23. {$elsec}
  24.  
  25.     const
  26.         res_id = 9367;
  27.         
  28.     type
  29.         Items = ( I_None, I_Total, I_Contig );
  30.         
  31.     type
  32.         HeapWatcherObject = object(DObject)
  33.             procedure DoIdleAlways;
  34.             override;
  35.         end;
  36.         
  37.     var
  38.         gHWenabled: boolean;
  39.         heapwindow: HeapWatcherObject;
  40.  
  41.     procedure HeapWatcherObject.DoIdleAlways;
  42.         var
  43.             t,c: longint;
  44.     begin
  45.         PurgeSpace( t, c );
  46.         SetItemText( window, ord(I_Total), NumToStr( t ) );
  47.         SetItemText( window, ord(I_Contig), NumToStr( c ) );
  48.     end;
  49.     
  50.     function InitHeapWatcher( var msg: integer ): OSStatus;
  51.     begin
  52. {$unused(msg)}
  53.         if gHWenabled then begin
  54.             new(heapwindow);
  55.             heapwindow.Create( res_id );
  56.             heapwindow.onlyone := @heapwindow;
  57.             heapwindow.DoIdleAlways;
  58.             ShowWindow( heapwindow.window );
  59.         end else begin
  60.             heapwindow := nil;
  61.         end;
  62.         InitHeapWatcher := noErr;
  63.     end;
  64.  
  65.     procedure FinishHeapWatcher;
  66.     begin
  67.         if heapwindow <> nil then begin
  68.             heapwindow.DoClose;
  69.         end;
  70.     end;
  71.     
  72.     procedure ConfigureHeapWatcher( enabled: boolean );
  73.     begin
  74.         gHWenabled := enabled;
  75.         StartupHeapWatcher;
  76.     end;
  77.     
  78.     procedure StartupHeapWatcher;
  79.     begin
  80.         StartupMainLoop;
  81.         SetStartup( InitHeapWatcher, nil, 0, FinishHeapWatcher );
  82.     end;
  83.     
  84. {$endc}
  85.  
  86. end.
  87.